home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp4.arc / SENDKER2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-10-04  |  38KB  |  874 lines
  1. (*----------------------------------------------------------------------*)
  2. (*    Initialize_Send_Display --- Set up display of Kermit reception    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Initialize_Send_Display;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Initialize_Send_Display                              *)
  10. (*                                                                      *)
  11. (*     Purpose:    Initializes status display for Kermit transfers      *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Initialize_Send_Display;                                      *)
  16. (*                                                                      *)
  17. (*----------------------------------------------------------------------*)
  18.  
  19. BEGIN (* Initialize_Send_Display *)
  20.  
  21.    GoToXY( 1 , 1 );
  22.  
  23.    WRITE(' Packets sent         :');
  24.    ClrEol;
  25.  
  26.    GoToXY( 1 , 2 );
  27.    WRITE(' Bytes sent           :');
  28.    ClrEol;
  29.  
  30.    GoToXY( 1 , 3 );
  31.    WRITE(' Retries              :');
  32.    ClrEol;
  33.  
  34.    GoToXY( 1 , 4 );
  35.    WRITE(' Bytes to send        :');
  36.    ClrEol;
  37.  
  38.    GoToXY( 1 , 5 );
  39.    WRITE(' Last status message  :');
  40.    ClrEol;
  41.  
  42. END   (* Initialize_Send_Display *);
  43.  
  44. (*----------------------------------------------------------------------*)
  45. (*       Get_Kermit_File_Name --- Construct file name to Kermit form    *)
  46. (*----------------------------------------------------------------------*)
  47.  
  48. PROCEDURE Get_Kermit_File_Name( VAR OK_File : BOOLEAN );
  49.  
  50. (*----------------------------------------------------------------------*)
  51. (*                                                                      *)
  52. (*     Procedure:  Get_Kermit_File_Name                                 *)
  53. (*                                                                      *)
  54. (*     Purpose:    Gets name of next file to be transferred             *)
  55. (*                                                                      *)
  56. (*     Calling Sequence:                                                *)
  57. (*                                                                      *)
  58. (*        Get_Kermit_File_Name( VAR OK_File : BOOLEAN );                *)
  59. (*                                                                      *)
  60. (*           OK_File --- TRUE if file is OK to be transferred           *)
  61. (*                                                                      *)
  62. (*     Calls:                                                           *)
  63. (*                                                                      *)
  64. (*        Scan_Xfer_List                                                *)
  65. (*                                                                      *)
  66. (*     Remarks:                                                         *)
  67. (*                                                                      *)
  68. (*        The global variable 'FileName' gets the file name.            *)
  69. (*                                                                      *)
  70. (*----------------------------------------------------------------------*)
  71.  
  72. VAR
  73.    I: INTEGER;
  74.  
  75. BEGIN (* Get_Kermit_File_Name *)
  76.  
  77.    I             := 1;
  78.    FileName      := '';
  79.  
  80.    WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) AND ( I <= 12 ) DO
  81.       BEGIN
  82.          FileName := FileName + File_Entry.File_Name[I];
  83.          I        := I + 1;
  84.       END;
  85.  
  86.    OK_File := ( File_Entry.File_Attr AND
  87.                 ( Dir_Attr_Volume_Label + Dir_Attr_Subdirectory ) = 0 );
  88.  
  89.                                    (* If host mode, make sure file *)
  90.                                    (* is on xferlist!              *)
  91.    IF Host_Mode THEN
  92.       OK_File := Scan_Xfer_List( FileName );
  93.  
  94. END   (* Get_Kermit_File_Name *);
  95.  
  96. (*----------------------------------------------------------------------*)
  97. (*                 Get_File_Data --- get data from file                 *)
  98. (*----------------------------------------------------------------------*)
  99.  
  100. PROCEDURE Get_File_Data;
  101.  
  102. (*----------------------------------------------------------------------*)
  103. (*                                                                      *)
  104. (*     Procedure:  Get_File_Data                                        *)
  105. (*                                                                      *)
  106. (*     Purpose:    Gets next buffer of data from file being uploaded    *)
  107. (*                                                                      *)
  108. (*     Calling Sequence:                                                *)
  109. (*                                                                      *)
  110. (*        Get_File_Data;                                                *)
  111. (*                                                                      *)
  112. (*     Calls:                                                           *)
  113. (*                                                                      *)
  114. (*        Read_File_Handle                                              *)
  115. (*        Close_File_Handle                                             *)
  116. (*                                                                      *)
  117. (*     Remarks:                                                         *)
  118. (*                                                                      *)
  119. (*        The global variable 'Packet_Buffer_Data' gets the next batch  *)
  120. (*        of data.  'Read_Buffer^' holds the current 'Buffer_Size'      *)
  121. (*        characters read in.                                           *)
  122. (*                                                                      *)
  123. (*----------------------------------------------------------------------*)
  124.  
  125. VAR
  126.    Char_Count   : INTEGER;
  127.    Temp_8       : CHAR;
  128.    Temp_7       : CHAR;
  129.    B_Temp_8     : BYTE ABSOLUTE Temp_8;
  130.    B_Temp_7     : BYTE ABSOLUTE Temp_7;
  131.    Temp_Data    : STRING[120];
  132.    End_Of_File  : BOOLEAN;
  133.    Err          : INTEGER;
  134.    NRead        : INTEGER;
  135.    Ascii_File   : BOOLEAN;
  136.    L            : INTEGER;
  137.    MaxData      : INTEGER;
  138.  
  139. BEGIN (* Get_File_Data *)
  140.                                    (* Maximum length allowed for data *)
  141.  
  142.    MaxData := Kermit_Packet_Size - 3 - ( ORD( Kermit_Chk_Type ) - ORD('0') );
  143.  
  144.                                    (* Remember if ascii transfer *)
  145.  
  146.    Ascii_File := ( Kermit_File_Type_Var = Kermit_Ascii );
  147.  
  148.                                    (* Set data type packet *)
  149.    Packet_Buffer_Data := 'D';
  150.                                    (* Characters from file *)
  151.    Char_Count         := 0;
  152.                                    (* Not end of file yet *)
  153.    End_Of_File        := FALSE;
  154.                                    (* Get next batch of characters *)
  155.                                    (* from file                    *)
  156.    REPEAT
  157.                                    (* Check if we ran off end of   *)
  158.                                    (* buffer.  If so, read more    *)
  159.                                    (* characters into buffer.      *)
  160.  
  161.       IF ( Buffer_Pos >= Buffer_Size ) AND ( NOT End_Of_File ) THEN
  162.          BEGIN
  163.                                    (* Read Sector_size chars from file  *)
  164.                                    (* to be sent.                       *)
  165.  
  166.             NRead       := Buffer_Size;
  167.             Err         := Read_File_Handle( XFile_Handle, Read_Buffer^, NRead );
  168.             Buffer_Pos  := 0;
  169.             Buffer_Size := NRead;
  170.             End_Of_File := ( NRead <= 0 );
  171.  
  172.          END;
  173.                                    (* See if anything to be sent *)
  174.  
  175.       IF ( Buffer_Pos < Buffer_Size ) THEN
  176.          BEGIN
  177.                                    (* Pick up next character *)
  178.  
  179.             Buffer_Pos   := Buffer_Pos + 1;
  180.             B_Temp_8     := Read_Buffer^[ Buffer_Pos ];
  181.             B_Temp_7     := ( B_Temp_8 AND $7F );
  182.             Char_Count   := Char_Count + 1;
  183.  
  184.                                    (* Quote the 8-bit quote if found *)
  185.  
  186.             IF Quoting THEN
  187.                IF ( Temp_8 = Kermit_Quote_8_Char ) THEN
  188.                   Packet_Buffer_Data := Packet_Buffer_Data + Kermit_Quote_Char
  189.  
  190.                                    (* Perform 8th bit quoting *)
  191.  
  192.                ELSE IF ( B_Temp_8 > 127 ) THEN
  193.                   BEGIN
  194.                      Packet_Buffer_Data := Packet_Buffer_Data +
  195.                                            Kermit_Quote_8_Char;
  196.                      Temp_8             := Temp_7;
  197.                   END;
  198.                                    (* Perform control quoting *)
  199.  
  200.             IF ( B_Temp_8 < SP ) OR ( B_Temp_8 = DEL ) OR
  201.                ( Temp_8   = Kermit_Quote_Char ) THEN
  202.                BEGIN
  203.                   Packet_Buffer_Data := Packet_Buffer_Data + Kermit_Quote_Char;
  204.                   IF ( Temp_7 <> Kermit_Quote_Char ) THEN
  205.                      BEGIN
  206.                         B_Temp_7 := B_Temp_7 XOR 64;
  207.                         B_Temp_8 := B_Temp_8 XOR 64;
  208.                      END;
  209.                END;
  210.                                    (* Finally, insert either 8-bit or  *)
  211.                                    (* 7-bit version of character into  *)
  212.                                    (* packet.                          *)
  213.  
  214.             IF Ascii_File THEN
  215.                Packet_Buffer_Data := Packet_Buffer_Data + Temp_7
  216.             ELSE
  217.                Packet_Buffer_Data := Packet_Buffer_Data + Temp_8;
  218.  
  219.          END;
  220.                                    (* Make sure to stop at ^Z = EOF *)
  221.                                    (* on text files.                *)
  222.  
  223.       IF Ascii_File AND ( Temp_7 = ^Z ) THEN
  224.          BEGIN
  225.             End_Of_File        := TRUE;
  226.             Buffer_Pos         := Buffer_Size + 1;
  227.             L                  := LENGTH( Packet_Buffer_Data );
  228.             IF ( L > 1 ) THEN
  229.                Packet_Buffer_Data := COPY( Packet_Buffer_Data, 1, L - 1 )
  230.             ELSE
  231.                Packet_Buffer_Data := '';
  232.          END;
  233.  
  234.    UNTIL ( End_Of_File AND ( Buffer_Pos >= Buffer_Size ) ) OR
  235.          ( LENGTH( Packet_Buffer_Data ) >= MaxData );
  236.  
  237.                                    (* Record character count *)
  238.  
  239.    Buffer_Num  := Buffer_Num + Char_Count;
  240.  
  241.                                    (* Remember if end of file AND *)
  242.                                    (* buffer exhausted.           *)
  243.  
  244.    IF ( End_Of_File AND ( Buffer_Pos >= Buffer_Size ) ) THEN
  245.       BEGIN
  246.          File_Done := TRUE;
  247.          Err       := Close_File_Handle( XFile_Handle );
  248.       END
  249.    ELSE
  250.       File_Done := FALSE;
  251.  
  252. END    (* Get_File_Data *);
  253.  
  254. (*----------------------------------------------------------------------*)
  255. (*          Kermit_Send_Init --- send initialization packet             *)
  256. (*----------------------------------------------------------------------*)
  257.  
  258. PROCEDURE Kermit_Send_Init;
  259.  
  260. (*----------------------------------------------------------------------*)
  261. (*                                                                      *)
  262. (*     Procedure:  Kermit_Send_Init                                     *)
  263. (*                                                                      *)
  264. (*     Purpose:    Sends transfer initialization packet to host.        *)
  265. (*                                                                      *)
  266. (*     Calling Sequence:                                                *)
  267. (*                                                                      *)
  268. (*        Kermit_Send_Init;                                             *)
  269. (*                                                                      *)
  270. (*     Calls:                                                           *)
  271. (*                                                                      *)
  272. (*        Build_Packet                                                  *)
  273. (*        Send_Packet                                                   *)
  274. (*        Receive_Packet                                                *)
  275. (*                                                                      *)
  276. (*----------------------------------------------------------------------*)
  277.  
  278. VAR
  279.    Quote_8     : CHAR;
  280.    Repeat_Char : CHAR;
  281.  
  282. BEGIN (* Kermit_Send_Init *)
  283.  
  284.    Packet_Num   := 0;
  285.    Try          := 0;
  286.    Quoting      := FALSE;
  287.    His_Chk_Type := '1';
  288.                                    (* 8-bit quoting off for 8,n,1   *)
  289.                                    (* and ascii file type transfers *)
  290.  
  291.    IF ( ( Parity <> 'N' ) OR ( Data_Bits <> 8 ) ) AND
  292.       ( Kermit_File_Type_Var = Kermit_Binary ) THEN
  293.       BEGIN
  294.          Quote_8 := Kermit_Quote_8_Char;
  295.          Quoting := TRUE;
  296.       END
  297.    ELSE                            (* Willing to quote if necessary *)
  298.       Quote_8 := 'Y';
  299.                                    (* If repeating data to be allowed *)
  300.                                    (* (not yet in PibTerm)            *)
  301.    IF Repeating THEN
  302.       Repeat_Char := Kermit_Repeat_Char
  303.    ELSE
  304.       Repeat_Char := ' ';
  305.                                    (* Construct initialization packet *)
  306.  
  307.    Packet_Buffer_Data :=  'S' + Kermit_Char40( Kermit_Packet_Size )
  308.                               + Kermit_Char40( Kermit_TimeOut     )
  309.                               + Kermit_Char40( Kermit_Npad        )
  310.                               + Kermit_Ctrl  ( Kermit_Pad_Char    )
  311.                               + Kermit_Char40( ORD( Kermit_EOL )  )
  312.                               + Kermit_Quote_Char
  313.                               + Quote_8
  314.                               + Kermit_Chk_Type
  315.                               + Repeat_Char;
  316.  
  317.    Build_Packet;
  318.  
  319.    REPEAT
  320.                                    (* Ensure type 1 block check here *)
  321.       His_Chk_Type := '1';
  322.                                    (* Assume bad until proved otherwise *)
  323.       ACK_OK := FALSE;
  324.                                    (* Send initialization packet *)
  325.       Send_Packet;
  326.                                    (* Check response *)
  327.       Receive_Packet;
  328.                                    (* If right response then check *)
  329.                                    (* if received packet jives     *)
  330.                                    (* with what we sent.           *)
  331.       IF ( Packet_OK AND
  332.          ( Kermit_Packet_Type = ACK_Pack ) AND
  333.          ( NOT Kermit_Abort ) ) THEN
  334.          Check_Init( ACK_OK );
  335.                                    (* Increment count of tries     *)
  336.       Try := Try + 1;
  337.  
  338.    UNTIL ACK_OK OR Kermit_Abort OR ( Try = Kermit_MaxTry );
  339.  
  340.                                    (* If OK, then get ready to send  *)
  341.                                    (* file header packet, else abort *)
  342.    IF ACK_OK THEN
  343.       Kermit_State := Send_File_Header
  344.    ELSE
  345.       Kermit_Abort := TRUE;
  346.  
  347. END   (* Kermit_Send_Init *);
  348.  
  349. (*----------------------------------------------------------------------*)
  350. (* Build_And_Send_Packet_With_Retry --- Build & send packet with retry  *)
  351. (*----------------------------------------------------------------------*)
  352.  
  353. PROCEDURE Build_And_Send_Packet_With_Retry;
  354.  
  355. (*----------------------------------------------------------------------*)
  356. (*                                                                      *)
  357. (*     Procedure:  Build_And_Send_Packet_With_Retry                     *)
  358. (*                                                                      *)
  359. (*     Purpose:    Sends packet to remote Kermit and retries if         *)
  360. (*                 packet not acknowledged.                             *)
  361. (*                                                                      *)
  362. (*     Calling Sequence:                                                *)
  363. (*                                                                      *)
  364. (*        Build_And_Send_Packet_With_Retry;                             *)
  365. (*                                                                      *)
  366. (*                                                                      *)
  367. (*     Calls:                                                           *)
  368. (*                                                                      *)
  369. (*        Build_Packet                                                  *)
  370. (*        Check_ACK                                                     *)
  371. (*                                                                      *)
  372. (*----------------------------------------------------------------------*)
  373.  
  374. BEGIN (* Build_And_Send_Packet_With_Retry *)
  375.  
  376.                                    (* Build the packet *)
  377.    Build_Packet;
  378.                                    (* No tries yet *)
  379.    Try := 0;
  380.                                    (* Begin loop over sending tries *)
  381.    REPEAT
  382.                                    (* Send the packet *)
  383.       Send_Packet;
  384.                                    (* See if it was acknowledged *)
  385.       Check_ACK;
  386.                                    (* Increment count of send packet tries *)
  387.       Try := Try + 1;
  388.                                    (* Stop if OK, abort requested, or too *)
  389.                                    (* many tries.                         *)
  390.  
  391.    UNTIL ACK_OK OR Kermit_Abort OR ( Try = Kermit_MaxTry );
  392.  
  393. END   (* Build_And_Send_Packet_With_Retry *);
  394.  
  395. (*----------------------------------------------------------------------*)
  396. (*      Kermit_Send_Header --- send file header (file name) packet      *)
  397. (*----------------------------------------------------------------------*)
  398.  
  399. PROCEDURE Kermit_Send_Header;
  400.  
  401. (*----------------------------------------------------------------------*)
  402. (*                                                                      *)
  403. (*     Procedure:  Kermit_Send_Header                                   *)
  404. (*                                                                      *)
  405. (*     Purpose:    Sends file name packet to remote Kermit.             *)
  406. (*                                                                      *)
  407. (*     Calling Sequence:                                                *)
  408. (*                                                                      *)
  409. (*        Kermit_Send_Header;                                           *)
  410. (*                                                                      *)
  411. (*     Calls:                                                           *)
  412. (*                                                                      *)
  413. (*        Build_And_Send_Packet_With_Retry                              *)
  414. (*                                                                      *)
  415. (*----------------------------------------------------------------------*)
  416.  
  417. BEGIN (* Kermit_Send_Header *)
  418.  
  419.                                    (* Construct file name packet *)
  420.  
  421.    Packet_Num         := Packet_Num + 1;
  422.    Packet_Buffer_Data := 'F' + FileName;
  423.  
  424.                                    (* Send the packet *)
  425.  
  426.    Build_And_Send_Packet_With_Retry;
  427.  
  428.                                    (* If it was ACKed, then *)
  429.                                    (* prepare to send file. *)
  430.    IF ACK_OK THEN
  431.       Kermit_State := Send_File
  432.    ELSE
  433.       Kermit_Abort := TRUE;
  434.  
  435. END    (* Kermit_Send_Header *);
  436.  
  437. (*----------------------------------------------------------------------*)
  438. (*              Kermit_Send_File --- send file data itself              *)
  439. (*----------------------------------------------------------------------*)
  440.  
  441. PROCEDURE Kermit_Send_File;
  442.  
  443. (*----------------------------------------------------------------------*)
  444. (*                                                                      *)
  445. (*     Procedure:  Kermit_Send_File                                     *)
  446. (*                                                                      *)
  447. (*     Purpose:    Sends file data packets to remote Kermit.            *)
  448. (*                                                                      *)
  449. (*     Calling Sequence:                                                *)
  450. (*                                                                      *)
  451. (*        Kermit_Send_File;                                             *)
  452. (*                                                                      *)
  453. (*     Calls:                                                           *)
  454. (*                                                                      *)
  455. (*        Build_And_Send_Packet_With_Retry                              *)
  456. (*                                                                      *)
  457. (*----------------------------------------------------------------------*)
  458.  
  459. BEGIN  (* Kermit_Send_File *)
  460.                                    (* Send file packets until entire  *)
  461.                                    (* file is sent OR transfer aborts *)
  462.  
  463.    Display_Kermit_Message('Sending...');
  464.  
  465.    REPEAT
  466.                                     (* Increment packet number          *)
  467.       Packet_Num := Packet_Num + 1;
  468.  
  469.                                     (* Get next block of data from file *)
  470.       Get_File_Data;
  471.                                     (* Construct and send data packet   *)
  472.  
  473.       Build_And_Send_Packet_With_Retry;
  474.  
  475.    UNTIL File_Done OR Kermit_Abort;
  476.  
  477.                                    (* If entire file done, prepare to send *)
  478.                                    (* EOF packet.                          *)
  479.    IF File_Done THEN
  480.       Kermit_State := Send_EOF;
  481.  
  482. END   (* Kermit_Send_File *);
  483.  
  484. (*----------------------------------------------------------------------*)
  485. (*              Kermit_Send_EOF --- send end of file packet             *)
  486. (*----------------------------------------------------------------------*)
  487.  
  488. PROCEDURE Kermit_Send_EOF;
  489.  
  490. (*----------------------------------------------------------------------*)
  491. (*                                                                      *)
  492. (*     Procedure:  Kermit_Send_EOF                                      *)
  493. (*                                                                      *)
  494. (*     Purpose:    Sends end of file packet to remote Kermit marking    *)
  495. (*                 no more data in current file being transferred.      *)
  496. (*                                                                      *)
  497. (*     Calling Sequence:                                                *)
  498. (*                                                                      *)
  499. (*        Kermit_Send_EOF;                                              *)
  500. (*                                                                      *)
  501. (*     Calls:                                                           *)
  502. (*                                                                      *)
  503. (*        Build_And_Send_Packet_With_Retry                              *)
  504. (*                                                                      *)
  505. (*----------------------------------------------------------------------*)
  506.  
  507. BEGIN (* Kermit_Send_EOF *)
  508.  
  509.                                    (* Prepare EOF packet *)
  510.  
  511.    Packet_Num         := ( Packet_Num + 1 ) MOD 64;
  512.    Packet_Buffer_Data := EOF_Packet;
  513.  
  514.                                    (* Send EOF Packet *)
  515.  
  516.    Build_And_Send_Packet_With_Retry;
  517.  
  518.                                    (* If OK then prepare to try *)
  519.                                    (* for another file, if any  *)
  520.    IF ACK_OK THEN
  521.       Kermit_State := Send_Break
  522.    ELSE
  523.       Kermit_Abort := TRUE;
  524.  
  525. END   (* Kermit_Send_EOF *);
  526.  
  527. (*----------------------------------------------------------------------*)
  528. (*                 Kermit_Send_Break --- send break packet              *)
  529. (*----------------------------------------------------------------------*)
  530.  
  531. PROCEDURE Kermit_Send_Break;
  532.  
  533. (*----------------------------------------------------------------------*)
  534. (*                                                                      *)
  535. (*     Procedure:  Kermit_Send_Break                                    *)
  536. (*                                                                      *)
  537. (*     Purpose:    Sends break packet to remote Kermit.                 *)
  538. (*                                                                      *)
  539. (*     Calling Sequence:                                                *)
  540. (*                                                                      *)
  541. (*        Kermit_Send_Break;                                            *)
  542. (*                                                                      *)
  543. (*     Calls:                                                           *)
  544. (*                                                                      *)
  545. (*        Build_And_Send_Packet_With_Retry                              *)
  546. (*                                                                      *)
  547. (*----------------------------------------------------------------------*)
  548.  
  549. BEGIN (* Kermit_Send_Break *)
  550.  
  551.                                    (* Construct break packet *)
  552.  
  553.    Kermit_State       := Send_Break;
  554.    Packet_Num         := ( Packet_Num + 1 ) MOD 64;
  555.    Packet_Buffer_Data := Break_Packet;
  556.  
  557.                                    (* Send the break packet *)
  558.  
  559.    Build_And_Send_Packet_With_Retry;
  560.  
  561.                                    (* If OK, then sending of file complete *)
  562.    IF ACK_OK THEN
  563.       Send_Done := TRUE
  564.    ELSE
  565.       Kermit_Abort := TRUE;
  566.  
  567. END    (* Kermit_Send_Break *);
  568.  
  569. (*----------------------------------------------------------------------*)
  570. (*       Kermit_Send_One_File --- Controls sending of a single file     *)
  571. (*----------------------------------------------------------------------*)
  572.  
  573. PROCEDURE Kermit_Send_One_File;
  574.  
  575. (*----------------------------------------------------------------------*)
  576. (*                                                                      *)
  577. (*     Procedure:  Kermit_Send_One_File                                 *)
  578. (*                                                                      *)
  579. (*     Purpose:    Sends a single file to remote Kermit.                *)
  580. (*                                                                      *)
  581. (*     Calling Sequence:                                                *)
  582. (*                                                                      *)
  583. (*        Kermit_Send_One_File;                                         *)
  584. (*                                                                      *)
  585. (*     Calls:                                                           *)
  586. (*                                                                      *)
  587. (*        Draw_Menu_Frame                                               *)
  588. (*        Initialize_Send_Display                                       *)
  589. (*        Open_File                                                     *)
  590. (*                                                                      *)
  591. (*----------------------------------------------------------------------*)
  592.  
  593. BEGIN  (* Kermit_Send_One_File *)
  594.  
  595.                                    (* Open file transfer display window *)
  596.    Window( 1, 1, 80, 25 );
  597.  
  598.    Menu_Title := 'Send file ' + FileName + ' using Kermit';
  599.  
  600.    Draw_Menu_Frame( 15, 10, 78, 21, Menu_Frame_Color,
  601.                     Menu_Text_Color, Menu_Title );
  602.  
  603.    Window( 16, 11, 77, 20 );
  604.                                    (* Display send titling information *)
  605.    Initialize_Send_Display;
  606.                                    (* Display init packet parameters   *)
  607.    Display_Kermit_Init_Params;
  608.                                    (* Try opening file to be sent      *)
  609.  
  610.    Open_File( Read_Open, FileName );
  611.  
  612.                                    (* If open went OK, then do transfer. *)
  613.    IF ( Open_OK ) THEN
  614.       BEGIN
  615.                                    (* Ensure record read first time by *)
  616.                                    (* pointing buffer pointer past end *)
  617.                                    (* of file buffer.                  *)
  618.  
  619.          Buffer_Pos := Buffer_Size + 1;
  620.  
  621.                                    (* Loop over states in transfer until     *)
  622.                                    (* transfer aborted OR file is completely *)
  623.                                    (* sent.                                  *)
  624.          REPEAT
  625.  
  626.             CASE Kermit_State OF
  627.                Send_Init        : Kermit_Send_Init;
  628.                Send_File_Header : Kermit_Send_Header;
  629.                Send_File        : Kermit_Send_File;
  630.                Send_EOF         : Kermit_Send_EOF;
  631.                Send_Break       : Send_Done := TRUE;
  632.             END  (* CASE *);
  633.  
  634.          UNTIL ( Kermit_Abort OR Send_Done );
  635.  
  636.          IF Send_Done THEN
  637.             Display_Kermit_Message('Completed.')
  638.          ELSE
  639.             Display_Kermit_Message('Kermit Aborted.');
  640.  
  641.       END  (* IF Open_OK *);
  642.  
  643. END    (* Kermit_Send_One_File *);
  644.  
  645. (*----------------------------------------------------------------------*)
  646. (*   Do_Kermit_Send --- Controls sending of list of files in Kermit     *)
  647. (*----------------------------------------------------------------------*)
  648.  
  649. PROCEDURE Do_Kermit_Send;
  650.  
  651. (*----------------------------------------------------------------------*)
  652. (*                                                                      *)
  653. (*     Procedure:  Do_Kermit_Send                                       *)
  654. (*                                                                      *)
  655. (*     Purpose:    Controls sending of list of files in Kermit          *)
  656. (*                                                                      *)
  657. (*     Calling Sequence:                                                *)
  658. (*                                                                      *)
  659. (*        Do_Kermit_Send;                                               *)
  660. (*                                                                      *)
  661. (*     Calls:                                                           *)
  662. (*                                                                      *)
  663. (*        Save_Screen                                                   *)
  664. (*        Restore_Screen                                                *)
  665. (*        Initialize_Send_Display                                       *)
  666. (*        Display_Kermit_Message                                        *)
  667. (*        Dir_Find_First_File                                           *)
  668. (*        Dir_Find_Next_File                                            *)
  669. (*        Get_Kermit_File_Name                                          *)
  670. (*        Kermit_Send_One_File                                          *)
  671. (*        Reset_Global_Colors                                           *)
  672. (*                                                                      *)
  673. (*----------------------------------------------------------------------*)
  674.  
  675. BEGIN  (* Do_Kermit_Send *)
  676.                                    (* Open display window for transfer  *)
  677.    Save_Screen( Local_Save );
  678.                                    (* Initialize status display information *)
  679.    Packets_Sent     := 0;
  680.    Packets_Received := 0;
  681.    Packets_Bad      := 0;
  682.    Buffer_Num       := 0.0;
  683.    Kermit_MaxTry    := 5;
  684.                                    (* Prepare Kermit to send initialization *)
  685.                                    (* packet.                               *)
  686.    Kermit_State := Send_Init;
  687.                                    (* Display transfer headings      *)
  688.    Initialize_Send_Display;
  689.                                    (* See if we can find anything to *)
  690.                                    (* be sent.                       *)
  691.  
  692.    Stop_Send    := ( Dir_Find_First_File( File_Pattern, File_Entry ) <> 0 );
  693.  
  694.    IF Stop_Send THEN
  695.       BEGIN
  696.          Display_Kermit_Message('  No files found to send.');
  697.          DELAY( Two_Second_Delay );
  698.       END
  699.    ELSE                            (* Wait for delay time to expire in *)
  700.                                    (* host mode.                       *)
  701.       IF Host_Mode THEN
  702.          DELAY( 1000 * Kermit_Delay_Time );
  703.  
  704.                                    (* Allocate buffer if requested   *)
  705.                                    (* otherwise use sector data area *)
  706.                                    (* directly.                      *)
  707.    IF Max_Write_Buffer > 1024 THEN
  708.       BEGIN
  709.          Buffer_Length  := Max_Write_Buffer;
  710.          Long_Buffer    := TRUE;
  711.          GetMem( Read_Buffer , Buffer_Length );
  712.       END
  713.    ELSE
  714.       BEGIN
  715.          Long_Buffer  := FALSE;
  716.          Read_Buffer  := ADDR( Sector_Data );
  717.       END;
  718.                                    (* Loop over file names         *)
  719.    WHILE( NOT Stop_Send ) DO
  720.       BEGIN
  721.                                    (* Initialize    *)
  722.          Send_Done     := FALSE;
  723.          File_Done     := FALSE;
  724.          Kermit_Abort  := FALSE;
  725.          Kermit_Retry  := FALSE;
  726.          Buffer_Size   := Buffer_Length;
  727.  
  728.                                    (* Get file name *)
  729.  
  730.          Get_Kermit_File_Name( OK_File );
  731.  
  732.                                    (* If file can be sent, do it   *)
  733.          IF OK_File THEN
  734.             BEGIN
  735.                Kermit_Send_One_File;
  736.                Kermit_State := Send_File_Header;
  737.             END;
  738.                                    (* See if more files to transfer *)
  739.  
  740.          Stop_Send := Stop_Send OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  741.  
  742.                                    (* Send break packet if no more files *)
  743.          IF Stop_Send THEN
  744.             Kermit_Send_Break;
  745.  
  746.       END (* WHILE *);
  747.                                    (* Remove download buffer           *)
  748.  
  749.    IF Long_Buffer THEN
  750.       FREEMEM( Read_Buffer , Buffer_Length );
  751.  
  752.                                    (* Remove Kermit window             *)
  753.    Restore_Screen( Local_Save );
  754.  
  755.    Reset_Global_Colors;
  756.  
  757. END    (* Do_Kermit_Send *);
  758.  
  759. (*----------------------------------------------------------------------*)
  760. (*   Get_File_Pattern --- get wildcard specification for files to send  *)
  761. (*----------------------------------------------------------------------*)
  762.  
  763. PROCEDURE Get_File_Pattern;
  764.  
  765. BEGIN (* Get_File_Pattern *)
  766.  
  767.    GoToXY( 2 , 6 );
  768.  
  769.    WRITE('File to send: ');
  770.  
  771.    IF ( NOT Host_Mode ) THEN
  772.       READLN( File_Pattern )
  773.    ELSE
  774.       BEGIN
  775.          WRITE( FileName );
  776.          File_Pattern := FileName;
  777.       END;
  778.  
  779. END   (* Get_File_Pattern *);
  780.  
  781. (*----------------------------------------------------------------------*)
  782.  
  783. BEGIN (* Send_Kermit_File *)
  784.                                    (* Save current screen *)
  785.    Save_Screen( Local_Save_2 );
  786.                                    (* Get Kermit menu *)
  787.    WITH Kermit_Menu DO
  788.       BEGIN
  789.  
  790.          Menu_Size    := 4;
  791.          Menu_Default := 1;
  792.          Menu_Row     := 11;
  793.          Menu_Column  := 20;
  794.          Menu_Tcolor  := Menu_Text_Color;
  795.          Menu_Bcolor  := BackGround_Color;
  796.          Menu_Fcolor  := Menu_Frame_Color;
  797.          Menu_Width   := 40;
  798.          Menu_Height  := 10;
  799.  
  800.       END (* WITH Kermit_Menu *);
  801.  
  802.    FOR I := 1 TO 4 DO
  803.       WITH Kermit_Menu.Menu_Entries[I] DO
  804.       BEGIN
  805.          Menu_Item_Row    := I;
  806.          Menu_Item_Column := 2;
  807.          CASE I OF
  808.             1:  Menu_Item_Text := 'a) Send Text File';
  809.             2:  Menu_Item_Text := 'b) Send Binary File';
  810.             3:  Menu_Item_Text := 'L) Logout Remote Server';
  811.             4:  Menu_Item_Text := 'Q) Quit Kermit';
  812.          END (* CASE *);
  813.       END;
  814.  
  815.    Kermit_Menu.Menu_Title := 'Choose Kermit function: ';
  816.    Kermit_Done            := FALSE;
  817.    Sending_File           := TRUE;
  818.    Host_Count             := 0;
  819.  
  820.                                    (* Begin loop over send choices *)
  821.    REPEAT
  822.                                    (* Reinitialize global Kermit variables *)
  823.       Kermit_Init;
  824.                                    (* Display send menu *)
  825.       IF ( NOT Host_Mode ) THEN
  826.          BEGIN
  827.             Menu_Display_Choices( Kermit_Menu );
  828.             Menu_Choice := Menu_Get_Choice( Kermit_Menu , Dont_Erase_Menu );
  829.          END
  830.       ELSE
  831.          BEGIN
  832.             Host_Count := Host_Count + 1;
  833.             IF ( Host_Count = 1 ) THEN
  834.                IF Kermit_File_Type_Var <> Kermit_Binary THEN
  835.                   Menu_Choice := 1
  836.                ELSE
  837.                   Menu_Choice := 2
  838.             ELSE
  839.                Menu_Choice := 4;
  840.          END;
  841.                                    (* Choose function to perform *)
  842.  
  843.       CASE Menu_Choice OF
  844.  
  845.          1: BEGIN (* Send Ascii text file *)
  846.                Kermit_File_Type_Var := Kermit_Ascii;
  847.                Get_File_Pattern;
  848.                IF LENGTH( File_Pattern ) > 0 THEN
  849.                   Do_Kermit_Send;
  850.             END;
  851.  
  852.          2: BEGIN (* Send binary file *)
  853.                Kermit_File_Type_Var := Kermit_Binary;
  854.                Get_File_Pattern;
  855.                IF LENGTH( File_Pattern ) > 0 THEN
  856.                   Do_Kermit_Send;
  857.             END;
  858.  
  859.                                    (* Logout remote Kermit server *)
  860.          3: Kermit_Finish_Server;
  861.  
  862.                                    (* Stop sends *)
  863.          4: Kermit_Done := TRUE;
  864.  
  865.       END (* CASE *);
  866.  
  867.    UNTIL Kermit_Done;
  868.  
  869.    Restore_Screen( Local_Save_2 );
  870.  
  871.    Reset_Global_Colors;
  872.  
  873. END   (* Send_Kermit_File *);
  874.